home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostuf / starwar2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-25  |  8.8 KB  |  427 lines
  1. program starwars_scroller;
  2. {
  3.   STARWARS-SCROLLER
  4.   - by Bjarke Viksφe
  5.   feb 1994
  6.  
  7.   THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  8.   YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  9.   E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
  10.  
  11.   Needs ilbm-font called 'font.lbm' in current path.
  12.   Font by SLIDE, ol' buggar.
  13.  
  14.   This is a simple horizontal scaled line engine.
  15. }
  16.  
  17. (*{$DEFINE DEBUG}*)
  18.  
  19. uses
  20.     DEMOINIT, TWEAK1;
  21.  
  22. const
  23.     LINES = 100;                    {pixel-lines of starwars-text}
  24.     ABUFSIZE = 5500;                {pre-calc buffer-size}
  25.  
  26.     MAXSTRINGS = 5;                {lines of scroll-text}
  27.     MAXTEXTSIZE = WIDTH*190;    {size of textbuffer-plane}
  28.  
  29.  
  30. type
  31.     addbufptr = ^addbuftype;
  32.     addbuftype = array[0..ABUFSIZE] of word;
  33.     addptrptr = ^addptrtype;
  34.     addptrtype = array[0..lines] of pointer;
  35.     addsizeptr = ^addsizetype;
  36.     addsizetype = array[0..lines] of word;
  37.     xposptr = ^xpostype;
  38.     xpostype = array[0..lines] of word;
  39.  
  40.     scrollstring = string[14];
  41.  
  42. var
  43.     font : pScreen;
  44.     buffer : pScreen;
  45.  
  46.     addbuffer1 : addbufptr;
  47.     addptrs1 : addptrtype;
  48.     addsize1 : addsizetype;
  49.     xpos1 : xpostype;
  50.  
  51.     addbuffer2 : addbufptr;
  52.     addptrs2 : addptrtype;
  53.     addsize2 : addsizetype;
  54.     xpos2 : xpostype;
  55.  
  56.     addbuffer3 : addbufptr;
  57.     addptrs3 : addptrtype;
  58.     addsize3 : addsizetype;
  59.     xpos3 : xpostype;
  60.  
  61.     addbuffer4 : addbufptr;
  62.     addptrs4 : addptrtype;
  63.     addsize4 : addsizetype;
  64.     xpos4 : xpostype;
  65.  
  66.     scrolloffset : word;
  67.     textpos : integer;
  68.     textypos : integer;
  69.  
  70. const
  71.     display1 : integer = $0000;
  72.     display2 : integer = $4000;
  73.  
  74.     persp : array[0..lines] of word =
  75.     (2,1,2,2,1,1,2,2,1,1,2,2,1,1,1,2,1,1,1,1,1,2,1,1,1,1,2,1,
  76.     1,1,1,1,1,1,1,1,1,0,1,1,1,0,1,1,0,1,0,1,1,0,1,1,0,1,0,1,0,1,0,
  77.     1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,0,1,0,0,
  78.     0,0,0,1,0,0,0,0,0,1,0,0,0);
  79.  
  80.     scrolltext : array[1..MAXSTRINGS] of scrollstring =
  81.     ('             ',
  82.      ' DETTE ER EN ',
  83.      '  STARWARS-  ',
  84.      ' SCROLLER!!! ',
  85.      '             ');
  86.  
  87.  
  88.  
  89. (*------------------------------------------------*)
  90.  
  91. procedure CalcAddBuffer;
  92. {
  93.  Precalc arrays. Actually a simple horizontal-scaling is done here!
  94.  Uses float-points calculations which take up quite a few milliseconds
  95.  if you don't have an co-processor ;-) ...
  96. }
  97. const
  98.     scrsize = 80*200;
  99. var
  100.     x1,x2 : real;
  101.     a1,a2,dela : real;
  102.     x : word;
  103.     i,j : integer;
  104.     index1,size1 : word;
  105.     index2,size2 : word;
  106.     index3,size3 : word;
  107.     index4,size4 : word;
  108. begin
  109.     fillchar(addbuffer1^,ABUFSIZE,0);
  110.     fillchar(addbuffer2^,ABUFSIZE,0);
  111.     fillchar(addbuffer3^,ABUFSIZE,0);
  112.     fillchar(addbuffer4^,ABUFSIZE,0);
  113.  
  114.     index1:=0; index2:=0; index3:=0; index4:=0;
  115.  
  116.     x1:=104.0;
  117.     x2:=215.0;
  118.     for i:=0 to lines do begin
  119.         addptrs1[i]:=@addbuffer1^[index1];
  120.         addptrs2[i]:=@addbuffer2^[index2];
  121.         addptrs3[i]:=@addbuffer3^[index3];
  122.         addptrs4[i]:=@addbuffer4^[index4];
  123.         size1:=0; size2:=0; size3:=0; size4:=0;
  124.  
  125.         a1:=0.0; a2:=319.0;
  126.         dela := 319.0/(x2-x1);
  127.  
  128.         for j:=round(x1) to round(x2) do begin
  129.             x:=round(a1);
  130.             case (j and 3) of
  131.                 0 : begin
  132.                     if (size1=0) then xpos1[i]:=j shr 2;
  133.                     addbuffer1^[index1]:=(x shr 2)+((x and 3)*scrsize);
  134.                     inc(index1); inc(size1);
  135.                      end;
  136.                 1 : begin
  137.                     if (size2=0) then xpos2[i]:=j shr 2;
  138.                     addbuffer2^[index2]:=(x shr 2)+((x and 3)*scrsize);
  139.                     inc(index2); inc(size2);
  140.                      end;
  141.                 2 : begin
  142.                     if (size3=0) then xpos3[i]:=j shr 2;
  143.                     addbuffer3^[index3]:=(x shr 2)+((x and 3)*scrsize);
  144.                     inc(index3); inc(size3);
  145.                      end;
  146.                 3 : begin
  147.                     if (size4=0) then xpos4[i]:=j shr 2;
  148.                     addbuffer4^[index4]:=(x shr 2)+((x and 3)*scrsize);
  149.                     inc(index4); inc(size4);
  150.                      end;
  151.             end;
  152.             a1:=a1+dela;
  153.         end;
  154.         addsize1[i]:=size1;
  155.         addsize2[i]:=size2;
  156.         addsize3[i]:=size3;
  157.         addsize4[i]:=size4;
  158.         x1:=x1-1.0;
  159.         x2:=x2+1.0;
  160.     end;
  161. end;
  162.  
  163. procedure SetScrollText;
  164. const
  165.     alfabet : string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!.?:-()*,`/ ';
  166. var
  167.     ch : char;
  168.     nr : integer;
  169.     i,j,k : integer;
  170. begin
  171.     for i:=1 to MAXSTRINGS do
  172.         for j:=1 to length(scrolltext[i]) do begin
  173.             nr:=1;
  174.             ch:=scrolltext[i,j];
  175.             for k:=1 to length(alfabet) do if (ch=alfabet[k]) then nr:=k;
  176.             scrolltext[i,j]:=chr(nr-1);
  177.         end;
  178. end;
  179.  
  180. procedure SetColors;
  181. var
  182.     i,j : integer;
  183.     c : integer;
  184.     a,b : real;
  185. begin
  186.     a:=1.0;
  187.     for i:=0 to 31 do begin
  188.         c:=1;
  189.         for j:=0 to 7 do begin
  190.             SetRGB((i*8)+j,round(CMAP[c]*a),round(CMAP[c+1]*a),round(CMAP[c+2]*a));
  191.             inc(c,3);
  192.         end;
  193.         a:=a-(1.0/32.0);
  194.     end;
  195. end;
  196.  
  197. procedure InitDemo;
  198. var
  199.     i : word;
  200. begin
  201.     Screen_Off;
  202.     ClearWholeScreen;
  203.  
  204.     New(font);
  205.     New(buffer);
  206.     New(addbuffer1); New(addbuffer2); New(addbuffer3); New(addbuffer4);
  207.     LoadPix(font,'FONT.LBM');
  208.  
  209.     CalcAddBuffer;
  210.     SetScrollText;
  211.     SetColors;
  212.  
  213.     fillchar(buffer^,SCRSIZE,0);
  214.     for i:=0 to lines do persp[i]:=persp[i]*WIDTH;
  215.     scrolloffset:=0;
  216.     textpos:=1; textypos:=0;
  217.     Screen_on;
  218. end;
  219.  
  220. procedure UninitDemo;
  221. var
  222.     i : word;
  223. begin
  224.     Dispose(addbuffer1); Dispose(addbuffer2); Dispose(addbuffer3); Dispose(addbuffer4);
  225.     Dispose(buffer);
  226.     Dispose(font);
  227. end;
  228.  
  229.  
  230. (*------------------------------------------------*)
  231.  
  232. procedure SwapDisplay;
  233. var
  234.     temp : word;
  235. begin
  236.     temp:=display1;
  237.     display1:=display2;
  238.     display2:=temp;
  239.     SetAddress(Ptr(SEGA000,display2));
  240. end;
  241.  
  242.  
  243. (*------------------------------------------------*)
  244.  
  245. procedure StarWars(addptrs : addptrptr; addsize : addsizeptr; xpos : xposptr);
  246. {print scroll. Actually get offsets from pre-calc'ed arrays and
  247.  insert color-pixels in a line. Moves a word to speed up things.}
  248. var
  249.     i,colcount : integer;
  250.     col : byte;
  251.     scroffset, scry : word;
  252.     scrollpos : word;
  253.     bptr : pointer;
  254.     size : word;
  255. begin
  256.     scry := WIDTH*90;
  257.     scrollpos:=scrolloffset;
  258.     colcount:=0;
  259.     col:=$F8;
  260.  
  261.     for i:=0 to lines do begin
  262.         bptr := addptrs^[i];
  263.         scroffset:= xpos^[i]+scry;
  264.         size := addsize^[i];
  265.         inc(scrollpos,persp[i]);
  266.         if (scrollpos >= MAXTEXTSIZE) then dec(scrollpos,MAXTEXTSIZE);
  267.         asm
  268.             push    bp
  269.             mov    es,SEGA000
  270.             mov    di,display1
  271.             add    di,scroffset
  272.             mov    ax,WORD PTR buffer+2
  273.             {mov    fs,ax} DB $8E,$E0
  274.             mov    bx,WORD PTR buffer
  275.             add    bx,scrollpos
  276.             mov    cx,size
  277.             mov    dl,col
  278.             lds    si,bptr
  279.             cld
  280.  
  281.             test    di,1                {dest. address on even address?}
  282.             jz        @oneven
  283.             lodsw                        {get offset}
  284.             add    ax,bx
  285.             mov    bp,ax
  286.             DB FS; mov    al,[bp]    {get pixel}
  287.             add    al,dl                {add color factor}
  288.             stosb
  289.             dec    cx
  290.             jcxz    @done
  291. @oneven:
  292.             shr    cx,1
  293. @xloop:    lodsw                        {get offset}
  294.             add    ax,bx
  295.             mov    bp,ax
  296.             DB FS; mov    dh,[bp]    {get actual pixel}
  297.             add    dh,dl                {add color factor}
  298.             lodsw                        {get another offset}
  299.             add    ax,bx
  300.             mov    bp,ax
  301.             DB FS; mov    ah,[bp]    {get that pixel}
  302.             add    ah,dl                {add color factor}
  303.             mov    al,dh
  304.             stosw                        {store both pixels}
  305.             dec    cx
  306.             jnz    @xloop
  307. @done:
  308.             mov    ax,SEG @DATA
  309.             mov    ds,ax
  310.             pop    bp
  311.         end;
  312.         inc(scry,WIDTH);
  313.         inc(scrollpos,WIDTH);
  314.         if (scrollpos = MAXTEXTSIZE) then scrollpos:=0;
  315.         inc(colcount); if (colcount=4) then begin colcount:=0; dec(col,8); end;
  316.     end;
  317. end;
  318.  
  319.  
  320. (*------------------------------------------------*)
  321.  
  322. procedure DoText;
  323. {copy one line from each char to the buffer.
  324.  Notice that we use mirror-buffer so no scrolling is needed}
  325. var
  326.     i : integer;
  327.     plotoffset : word;
  328.     yoff,stroff : word;
  329.     textantal : integer;
  330. begin
  331.     inc(scrolloffset,WIDTH);
  332.     if (scrolloffset = MAXTEXTSIZE) then scrolloffset:=0;
  333.     plotoffset:=scrolloffset+(185*WIDTH);
  334.     if (plotoffset >= MAXTEXTSIZE) then dec(plotoffset,MAXTEXTSIZE);
  335.  
  336.     inc(textypos);
  337.     if (textypos = 32) then begin
  338.         textypos:=0;
  339.         inc(textpos); if (textpos > MAXSTRINGS) then textpos:=1;
  340.     end;
  341.     yoff := textypos*WIDTH;
  342.     stroff := (textpos-1)*SIZEOF(scrollstring);
  343.  
  344.     asm
  345.         mov    textantal,1
  346. @loop:
  347.         lea    si,scrolltext
  348.         add    si,stroff
  349.         add    si,textantal
  350.         xor    ah,ah
  351.         mov    al,[si]
  352.         cwd
  353.         mov    cx,10
  354.         div    cx
  355.         mov    bx,dx
  356.         cwd
  357.         mov    cx,80*32
  358.         mul    cx
  359.         shl    bx,3
  360.         add    ax,bx
  361.  
  362.         push    ds
  363.         les    di,buffer
  364.         add    di,plotoffset
  365.         lds    si,font
  366.         add    si,yoff
  367.         add    si,ax
  368.         cld
  369.         mov    bx,(80*200)-6
  370.         DB LONG; movsw
  371.         movsw
  372.         add    si,bx
  373.         add    di,bx
  374.         DB LONG; movsw
  375.         movsw
  376.         add    si,bx
  377.         add    di,bx
  378.         DB LONG; movsw
  379.         movsw
  380.         add    si,bx
  381.         add    di,bx
  382.         DB LONG; movsw
  383.         movsw
  384.         pop    ds
  385.  
  386.         add    plotoffset,6    {space (in bytes) between two chars}
  387.         inc    textantal
  388.         cmp    textantal,(TYPE scrollstring)-1
  389.         jne    @loop
  390.     end;
  391. end;
  392.  
  393.  
  394. (*------------------------------------------------*)
  395.  
  396. procedure RunOnce;
  397. begin
  398.     SwapDisplay;
  399.     VBLANK;
  400. {$IFDEF DEBUG}
  401.     setRGB(0,63,0,0);
  402. {$ENDIF}
  403.     SetBitplanes(1);
  404.     StarWars(@addptrs1,@addsize1,@xpos1);
  405.     SetBitplanes(2);
  406.     StarWars(@addptrs2,@addsize2,@xpos2);
  407.     SetBitplanes(4);
  408.     StarWars(@addptrs3,@addsize3,@xpos3);
  409.     SetBitplanes(8);
  410.     StarWars(@addptrs4,@addsize4,@xpos4);
  411.     DoText;
  412. {$IFDEF DEBUG}
  413.     setRGB(0,0,0,0);
  414. {$ENDIF}
  415. end;
  416.  
  417.  
  418. begin
  419.     OpenScreen;
  420.     InitDemo;
  421.     SetAllInterrupts;
  422.     repeat RunOnce until Key='e';
  423.     RestoreAllInterrupts;
  424.     UninitDemo;
  425.     CloseScreen;
  426. end.
  427.